home *** CD-ROM | disk | FTP | other *** search
- PROGRAM help3278;
- {$C-}
- {$K-}
-
- type
- ScreenLoc = record
- character : char;
- attribute : byte;
- end;
- ScreenLine = array[1..80] of ScreenLoc;
- Screen = array[1..25] of ScreenLine;
- LineType = string[80];
- var
- Mono : Screen absolute $B000:$0000;
- Colo : Screen absolute $B800:$0000;
-
- type
- arglist_string = string[80];
- var
- argvlist : array[1..9] of ^arglist_string;
- argument : arglist_string absolute cseg:$80;
- {@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@}
- var
- ScreenSeg : integer;
- color : boolean;
-
-
-
- {VARIABLE SECTION FOR 'POPUPHLP'}
-
- type
- text80 = string[80];
- RegType = record
- ax,bx,cx,dx,bp,si,di,ds,es,flags:integer
- end;
- HalfRegType = record
- al,ah,bl,bh,cl,ch,dl,dh:byte
- end;
- IntrType = record
- ip,cs : integer
- end;
-
- const
- EntryChar = 35; { ALT 'H' }
- Escape = 0;
- FirstRow = 1;
- FirstCol = 1;
- WindowWidth = 80;
- WindowLength = 24;
- UserInt = $67; { 66} { ***HERE IT IS*** }
- {if thelp will not work with your other
- resident stuff, change this number to
- a free interrupt}
- KybdInt = $16;
- ProgSize : integer = $A000; { approx. program size }
-
- Regs : regtype = (ax:0;bx:0;cx:0;dx:0;bp:0;si:0;di:0;ds:0;es:0;flags:0);
- SaveDS :integer = 0;
-
- var
- SaveReg : RegType;
- SaveHalf : HalfRegType absolute SaveReg;
- HalfReg : HalfRegType absolute regs;
- i,j,x,y : integer;
- CursorPos : integer;
- Selection : integer;
- savebuf : array[1..windowwidth] of array[1..windowlength] of integer;
-
- var
- Pops : array[1..3] of screen;
- N, M : byte;
- PopFile : text;
- OneLine : lineType;
- C, D : char;
-
-
- { MISC. PROCEDURES AND FUNTIONS FOR POPUPHLP }
-
- procedure CheckColor;
- begin
- if (Mem[0000:1040] and 48) <> 48 then
- begin
- ScreenSeg := $B800;
- color := true;
- end
- else
- begin
- ScreenSeg := $B000;
- color := false;
- end;
- end;
-
- procedure MakeScreen(VAR Line : ScreenLine ; att: byte;theLine : LineType);
- var
- row : byte;
- begin
- for row := 1 to length(theLine) do
- begin
- Line[row].character := theLine[row];
- Line[row].attribute := att;
- end;
- if length(theLine) < 80 then
- for row := length(theLine) + 1 to 80 do
- begin
- Line[row].character := ' ';
- Line[row].attribute := att;
- end;
- end;
-
- procedure GetScreensFromFile;
- {This is one way to put screens into memory}
- var l,rc:integer;
- temp: string[80];
- begin
- l := length(argument);
- temp := copy(argument,2,l-1);
- Assign(PopFile,temp);
- {$I-}
- reset(PopFile);
- {$I+}
- rc := IOresult;
- if rc <> 0 then
- begin
- Writeln('Popup help file (',temp, ') doesn''t exist.');
- Writeln('Usage: POPUPHLP FILENAME.HLP');
- inline($CD/$20);
- end;
- For n:= 0 to 24 do
- MakeScreen(Pops[1][N],112,' ');
-
- N := 0;
- while (not EOF(PopFile)) and (N < 25) do
- begin
- N := N + 1;
- readLn(PopFile,OneLine);
- MakeScreen(Pops[1][N],112,OneLine);
- end;
-
- close(PopFile);
- end;
-
- procedure DOIT;
- begin
- CheckColor;
- Pops[(2)] := Mono;
- Pops[(3)] := Colo;
- Mono := Pops[(1)];
- Colo := Pops[(1)];
- savereg.ax := $00;
- Intr(userint,savereg);
- selection := savehalf.ah - 1;
- Mono := Pops[(2)];
- Colo := Pops[(3)];
- end;
-
- procedure ProcessInt; { Start of interupt service }
- begin
- {when invoked, this procedure saves the registers into the structured constant
- 'REGS' and restores the ds from the previously saved integer constant 'saveds'}
-
- inline(
- $53/ {PUSH BX}
- $BB/regs/ {MOV BX,OFFSET REGS}
- $2E/$89/$47/$00/ {CS:MOV [BX]0,AX}
- $58/ {POP AX}
- $2E/$89/$47/$02/ {CS:MOV [BX]2,AX}
- $2E/$89/$4F/$04/ {CS:MOV [BX]4,CX}
- $2E/$89/$57/$06/ {CS:MOV [BX]6,DX}
- $2E/$89/$6F/$08/ {CS:MOV [BX]8,BP}
- $2E/$89/$77/$0A/ {CS:MOV [BX]A,SI}
- $2E/$89/$7F/$0C/ {CS:MOV [BX]C,DI}
- $2E/$8C/$5F/$0E/ {CS:MOV [BX]E,DS}
- $2E/$8C/$47/$10/ {CS:MOV [BX]10,ES}
- $9C/ {PUSHF}
- $58/ {POP AX}
- $2E/$89/$47/$12/ {CS:MOV [BX]12,AX}
- $2E/$8E/$1E/saveds {CS:MOV DS,SAVEDS -- PUT PROPER DS}
- );
-
- if halfreg.ah <> 0 then Intr(userint,regs) else
- begin
- Intr(userint,regs);
- if (halfreg.ah = EntryChar) and (halfreg.al = $00) then
- begin
- savereg.ax := $0300;
- savereg.bx := $0;
- Intr($10,savereg); { get cursor position }
- cursorpos := savereg.dx;
-
- DOIT;
-
- savereg.ax := $0200;
- savereg.bx := $0;
- savereg.dx := cursorpos;
- Intr($10,savereg); { restore cursor position }
-
- halfreg.ah := 0;
- Intr(userint,regs);
- end;
- end;
-
- {when invoked this routine restores the registers from the structure constant}
-
- inline(
- $BB/REGS/ {MOV BX,OFFSET REGS}
- $2E/$8E/$47/$10/ {CS:MOV ES,[BX]10}
- $2E/$8E/$5F/$0E/ {CS:MOV DS,[BX]0E}
- $2E/$8B/$7F/$0C/ {CS:MOV DI,[BX]0C}
- $2E/$8B/$77/$0A/ {CS:MOV SI,[BX]0A}
- $2E/$8B/$6F/$08/ {CS:MOV BP,[BX]08}
- $2E/$8B/$57/$06/ {CS:MOV DX,[BX]06}
- $2E/$8B/$4F/$04/ {CS:MOV CX,[BX]04}
- $2E/$8B/$47/$00/ {CS:MOV AX,[BX]00}
- $2E/$FF/$77/$12/ {CS:PUSH [BX]12}
- $9D/ {POPF}
- $2E/$8B/$5F/$02/ {CS:MOV BX,[BX]02}
- $5D/ {POP BP} {restore the stack pointer}
- $5D {POP BP}
- );
-
- inline ($CA/$02/$00) {RETF 02}
-
- end;
-
-
- { PROGRAM 'POPUPHLP' } { Program installation }
- begin
- SaveDS := dseg;
- SaveReg.ax := $3500 + UserInt;
- Intr($21,SaveReg); { get user interupt }
-
- if SaveReg.es <> $00 then
- begin
- writeln('User Interupt in use -- cant install POPUPHLP.');
- writeln('Reboot system with ALT/CNTL/DELELTE, then retry.');
- end
- else
-
- begin
- GetScreensFromFile;
- writeln('Installing Popup help - Press < ALT "H" > to get help.');
- writeln(' Press < ESC > to exit help.');
- savereg.ax := $3500 + KybdInt;
- Intr($21,savereg); { get keyboard interupt }
-
- savereg.ax := $2500 + UserInt;
- savereg.ds := savereg.es;
- savereg.dx := savereg.bx;
- Intr($21,savereg); { put in user interupt }
-
- savereg.ax := $2500 + KybdInt;
- savereg.ds := cseg;
- savereg.dx := ofs(ProcessInt);
- Intr($21,savereg); { install our interupt processor }
-
- savereg.dx := ProgSize;
- Intr($27,savereg); { terminate and stay resident }
- end;
- inline($CD/$20); { terminate if interupt in use }
- end.